home *** CD-ROM | disk | FTP | other *** search
/ CD ROM Paradise Collection 4 / CD ROM Paradise Collection 4 1995 Nov.iso / program / swagd_f.zip / DIRS.SWG / 0012_MAKEDIR1.PAS.pas < prev    next >
Pascal/Delphi Source File  |  1993-05-28  |  2KB  |  77 lines
  1. Program MakeChangeDir;
  2.  
  3. { Purpose:      - Make directories where they don't exist               }
  4. {                                                                       }
  5. { Useful for:   - Installation Type Programs                            }
  6. {                                                                       }
  7. { Useful notes: - seems to handles even directories With extentions     }
  8. {                 (i.e. DIRDIR.YYY)                                     }
  9. {               - there are some defaults that have been set up :-      }
  10. {                 change if needed                                      }
  11. {               - doesn't check to see how legal the required directory }
  12. {                 is (i.e. spaces, colon in the wrong place, etc.)      }
  13. {                                                                       }
  14. { Legal junk:   - this has been released to the public as public domain }
  15. {               - if you use it, give me some credit!                   }
  16. {                                                                       }
  17.  
  18. Var
  19.   Slash : Array[1..20] of Integer;
  20.  
  21. Procedure MkDirCDir(Target : String);
  22. Var
  23.   i,
  24.   count   : Integer;
  25.   dir,
  26.   home,
  27.   tempdir : String;
  28.  
  29. begin
  30.   { sample directory below to make }
  31.   Dir := Target;
  32.   { add slash at end if not given }
  33.   if Dir[Length(Dir)] <> '\' then
  34.     Dir := Dir + '\';
  35.   { if colon where normally is change to that drive }
  36.   if Dir[2] = ':' then
  37.     ChDir(Copy(Dir, 1, 2))
  38.   else
  39.   { assume current drive (and directory) }
  40.   begin
  41.     GetDir(0, Home);
  42.     if Dir[1] <> '\' then
  43.       Dir := Home + '\' + Dir
  44.     else
  45.       Dir := Home + Dir;
  46.   end;
  47.  
  48.   Count := 0;
  49.   { search directory For slashed and Record them }
  50.   For i := 1 to Length(Dir) do
  51.   begin
  52.     if Dir[i] = '\' then
  53.     begin
  54.       Inc(Count);
  55.       Slash[Count] := i;
  56.     end;
  57.   end;
  58.   { For each step of the way, change to the directory }
  59.   { if get error, assume it doesn't exist - make it }
  60.   { then change to it }
  61.   For i := 2 to Count do
  62.   begin
  63.     TempDir := Copy(Dir, 1, Slash[i] - 1);
  64.     {$I-}
  65.     ChDir(TempDir);
  66.     if IOResult <> 0 then
  67.     begin
  68.       MkDir(TempDir);
  69.       ChDir(TempDir);
  70.     end;
  71.   end;
  72. end;
  73.  
  74. begin
  75.   MkDirCDir('D:\HI.ZZZ\GEEKS\2JKD98');
  76. end.
  77.